home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / bbs / tdk_v136.zip / COMM.PAS < prev    next >
Pascal/Delphi Source File  |  1997-07-01  |  8KB  |  292 lines
  1. {
  2.  ▀▀▀▀▀▀▀▀  ▀▀▀▀▀▀    ▀▀   ▀▀
  3.    ▀▀     ▀▀   ▀▀   ▀▀  ▀▀
  4.   ▀▀     ▀▀   ▀▀▀  ▀▀▀▀▀  The DoorKit!
  5.  ▀▀     ▀▀   ▀▀   ▀▀  ▀▀
  6. ▀▀     ▀▀▀▀▀▀    ▀▀    ▀▀
  7. The BBS Door Development Kit By The People - For The People!
  8.  
  9.  
  10.    Feel free to modify or optimize this code at will. All I ask is that if
  11.    find a better way to do things (and you will), please send me a copy of
  12.    your modifications. Thanks in advance!....Larry L. Athey....}
  13.  
  14. {$A+,B-,D+,E+,F+,G+,I-,L+,N-,O+,P-,Q-,R-,S-,T-,V+,X+}
  15. UNIT COMM;
  16.  
  17. INTERFACE
  18.  
  19. USES TDK_VARS, FOSUNIT, ASYNC, DIGIBORD;
  20.  
  21. TYPE AsyncIOTypes = (Fossil,Internal,Bios,Digi);
  22.  
  23. VAR
  24.   AsyncIOType     : AsyncIOTypes;
  25.   InitOk,
  26.   NoFossInit,
  27.   FosBnu          : BOOLEAN;
  28.   InternalInSize,
  29.   InternalOutSize : WORD;
  30.  
  31. PROCEDURE SelectPort(PN : BYTE);
  32. PROCEDURE SendChar(Ch : CHAR);
  33. PROCEDURE ReceiveChar(VAR Ch : CHAR);
  34. FUNCTION  CarrierPresent : BOOLEAN;
  35. FUNCTION  Data_Available : BOOLEAN;
  36. PROCEDURE SelectFossil(VAR FossilName : STRING);
  37. PROCEDURE SelectInternal;
  38. PROCEDURE SelectDigiBoard(VAR DigiBoardName : STRING);
  39. PROCEDURE CloseUp;
  40. PROCEDURE CloseCom(CP : BYTE);
  41. PROCEDURE SetBaud(N : LONGINT);
  42. PROCEDURE Set_DTR(State : BOOLEAN);
  43. PROCEDURE Flush_Output;
  44. PROCEDURE Purge_Input;
  45. PROCEDURE Purge_Output;
  46. PROCEDURE SetFlow(SoftTran,Hard,SoftRecv : BOOLEAN);
  47. PROCEDURE BufferStatus(VAR InSize,InFree,OutSize,OutFree : WORD;
  48.                        VAR FossilName : STRING);
  49. PROCEDURE SetUpPorts;
  50. PROCEDURE LoadPorts(VAR port1,port2,port3,port4 : WORD;
  51.                     VAR irq1,irq2,irq3,irq4 : BYTE);
  52. PROCEDURE ResetPorts(VAR port1,port2,port3,port4 : WORD;
  53.                      VAR irq1,irq2,irq3,irq4 : BYTE);
  54.  
  55. IMPLEMENTATION
  56.  
  57. PROCEDURE SelectPort(PN : BYTE);
  58. BEGIN;
  59.   Comport := PN;
  60.   CASE AsyncIOType OF
  61.     Fossil   : BEGIN
  62.                  Port_Num := PN - 1;
  63.                  IF NoFossInit THEN BEGIN
  64.                    Async_Purge_Output;
  65.                    Async_Purge_Input;
  66.                    InitOk := TRUE;
  67.                  END ELSE BEGIN
  68.                    Async_DeInit_Fossil;
  69.                    InitOk := Async_Init_Fossil;
  70.                  END;
  71.                END;
  72.     Internal : BEGIN;
  73.                  CloseAllComs;
  74.                  InitOk := OpenCom(PN,InternalInSize,InternalOutSize);
  75.                END;
  76.     Digi     : BEGIN
  77.                  Dport_Num := PN - 1;
  78.                  InitOk    := Digi_Init_Driver;
  79.                END;
  80.   END;
  81. END;
  82.  
  83. PROCEDURE SendChar(Ch : CHAR);
  84. BEGIN;
  85.   CASE AsyncIOType OF
  86.     Fossil   : Async_Send(Ch);
  87.     Internal : BEGIN
  88.                  WHILE CTSStat(Comport) OR RTSstat(Comport) DO IF NOT CarrierPresent THEN EXIT;
  89.                  ComWriteChw(Comport,Ch);
  90.                END;
  91.     Digi     : BEGIN
  92.                  WHILE (NOT OutReady) DO IF NOT CarrierPresent THEN EXIT;
  93.                  Digi_Send(Ch);
  94.                END;
  95.   END;
  96. END;
  97.  
  98. PROCEDURE ReceiveChar(VAR Ch : CHAR);
  99. VAR
  100.   B : BOOLEAN;
  101. BEGIN;
  102.   CASE AsyncIOType OF
  103.     Fossil   : B  := Async_Receive(Ch);
  104.     Internal : Ch := ComReadCh(Comport);
  105.     Digi     : B  := Digi_Receive(Ch);
  106.   END;
  107. END;
  108.  
  109. FUNCTION CarrierPresent : BOOLEAN;
  110. BEGIN;
  111.   CASE AsyncIOType OF
  112.     Fossil   : CarrierPresent := Async_Carrier_Present;
  113.     Internal : CarrierPresent := DCDStat(Comport);
  114.     Digi     : CarrierPresent := Digi_Carrier_Present;
  115.   END;
  116. END;
  117.  
  118. FUNCTION Data_Available : BOOLEAN;
  119. BEGIN;
  120.   CASE AsyncIOType OF
  121.     Fossil   : Data_Available := Async_Buffer_Check;
  122.     Internal : Data_Available := ComBufferLeft(Comport,'I') <> C_InSize[Comport];
  123.     Digi     : Data_Available := Digi_Buffer_Check;
  124.   END;
  125. END;
  126.  
  127. PROCEDURE SelectFossil;
  128. VAR
  129.   InSize,InFree,OutSize,OutFree : WORD;
  130.   S : STRING;
  131.   P : BYTE;
  132. BEGIN;
  133.   AsyncIOType := Fossil;
  134.   BufferStatus(InSize,InFree,OutSize,OutFree,FossilName);
  135.   S := '';
  136.   FOR P := 1 TO LENGTH(FossilName) DO S := S + UPCASE(FossilName[P]);
  137.   P := POS('BNU',S);
  138.   IF P > 0 THEN FosBnu := TRUE;
  139. END;
  140.  
  141. PROCEDURE SelectDigiBoard;
  142. VAR
  143.   InSize,InFree,OutSize,OutFree : WORD;
  144. BEGIN;
  145.   AsyncIOType := Digi;
  146.   Digi_Get_Info(DigiBoardName);
  147. END;
  148.  
  149. PROCEDURE CloseUp;
  150. BEGIN;
  151.   CASE AsyncIOType OF
  152.     Fossil   : Async_DeInit_Fossil;
  153.     Internal : CloseAllComs;
  154.     Digi     : Digi_DeInit_Driver;
  155.   END;
  156. END;
  157.  
  158. PROCEDURE CloseCom;
  159. BEGIN;
  160.   CASE AsyncIOType OF
  161.     Fossil   : Async_DeInit_Fossil;
  162.     Internal : CloseCom(CP);
  163.     Digi     : Digi_DeInit_Driver;
  164.   END;
  165. END;
  166.  
  167. PROCEDURE SetBaud(N : LONGINT);
  168. VAR
  169.   I : BYTE;
  170. BEGIN;
  171.   CASE asynciotype OF
  172.     Fossil   : IF NOT NoFossInit THEN
  173.                IF FosBnu THEN Async_Set_BaudBnu(N)
  174.                ELSE Async_Set_Baud(N);
  175.     Internal : ComParams(Comport,N,DoorSys.WordSize,DoorSys.Parity,DoorSys.StopBits);
  176.     Digi     : BEGIN
  177.                 {InitOk := Digi_Set_Baud(N,DoorSys.WordSize,DoorSys.Parity,DoorSys.StopBits);}
  178.                  Digi_Flush_IO;
  179.                END;
  180.  
  181.   END;
  182. END;
  183.  
  184. PROCEDURE SelectInternal;
  185. BEGIN;
  186.   AsyncIOType := Internal;
  187. END;
  188.  
  189. PROCEDURE Set_DTR(State : BOOLEAN);
  190. BEGIN;
  191.   CASE AsyncIOType OF
  192.     Fossil   : Async_Set_DTR(State);
  193.     Internal : SetDTR(Comport,State);
  194.   END;
  195. END;
  196.  
  197. PROCEDURE Flush_Output;
  198. BEGIN;
  199.   CASE AsyncIOType OF
  200.     Fossil   : Async_Flush_Output;
  201.     Internal : ComWaitForClear(Comport);
  202.     Digi     : Digi_Flush_Output;
  203.   END;
  204. END;
  205.  
  206. PROCEDURE Purge_Output;
  207. BEGIN;
  208.   CASE AsyncIOType OF
  209.     Fossil   : Async_Purge_Output;
  210.     Internal : ClearCom(comport,'O');
  211.     Digi     : Digi_Flush_Output;
  212.   END;
  213. END;
  214.  
  215. PROCEDURE Purge_Input;
  216. BEGIN
  217.   CASE AsyncIOType OF
  218.     Fossil   : Async_Purge_Input;
  219.     Internal : ClearCom(Comport,'I');
  220.     Digi     : Digi_Flush_Input;
  221.   END;
  222. END;
  223.  
  224. PROCEDURE SetFlow(SoftTran,Hard,SoftRecv : BOOLEAN);
  225. BEGIN;
  226.   CASE AsyncIOType OF
  227.     Fossil   : Async_Set_Flow(SoftTran,Hard,SoftRecv);
  228.     Internal : BEGIN;
  229.                  SetCTSMode(Comport,Hard);
  230.                  SetRTSMode(Comport,Hard,C_RTSOn[Comport],C_RTSOff[Comport]);
  231.                  SoftHandShake(Comport,SoftTran,'A','A');
  232.                END;
  233.   END;
  234. END;
  235.  
  236. PROCEDURE BufferStatus(VAR InSize,InFree,OutSize,OutFree : WORD;
  237.                        VAR FossilName : STRING);
  238. BEGIN;
  239.   CASE AsyncIOType OF
  240.     Fossil   : Async_Buffer_Status(InSize,InFree,OutSize,OutFree,FossilName);
  241.     Internal : BEGIN;
  242.                  InSize  := InternalInSize;
  243.                  OutSize := InternalOutSize;
  244.                  InFree  := ComBufferLeft(Comport,'I');
  245.                  OutFree := ComBufferLeft(Comport,'O');
  246.                END;
  247.   END;
  248. END;
  249.  
  250. PROCEDURE SetUpPorts;
  251. VAR
  252.   I : BYTE;
  253. BEGIN
  254.   FOR I := 1 TO 4 DO BEGIN
  255.     C_PortAddr[I] := D_PortAddr[I];
  256.     C_PortInt[I]  := D_PortInt[I];
  257.   END;
  258. END;
  259.  
  260. PROCEDURE LoadPorts (VAR port1,port2,port3,port4 : WORD;
  261.                      VAR irq1,irq2,irq3,irq4 : BYTE);
  262. BEGIN
  263.   port1 := D_PortAddr[1];
  264.   irq1  := D_PortInt[1];
  265.   port2 := D_PortAddr[2];
  266.   irq2  := D_PortInt[2];
  267.   port3 := D_PortAddr[3];
  268.   irq3  := D_PortInt[3];
  269.   port4 := D_PortAddr[4];
  270.   irq4  := D_PortInt[4];
  271. END;
  272.  
  273. PROCEDURE ResetPorts (VAR port1,port2,port3,port4 : WORD;
  274.                       VAR irq1,irq2,irq3,irq4 : BYTE);
  275. BEGIN
  276.   C_PortAddr[1] := port1;
  277.   C_PortInt[1]  := irq1;
  278.   C_PortAddr[2] := port2;
  279.   C_PortInt[2]  := irq2;
  280.   C_PortAddr[3] := port3;
  281.   C_PortInt[3]  := irq3;
  282.   C_PortAddr[4] := port4;
  283.   C_PortInt[4]  := irq4;
  284. END;
  285.  
  286. BEGIN;
  287.   AsyncIOType     := Internal;
  288.   Comport         := 1;
  289.   InternalInSize  := 4096;
  290.   InternalOutSize := 4126;
  291. END.
  292.